home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / forms / frmwiz / rdblib / rbscrn.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-01-28  |  3.0 KB  |  90 lines
  1. VERSION 2.00
  2. Begin Form RBScrn
  3. BorderStyle     =   0  'None
  4. Caption         =   "Current Screen Print"
  5. ClientHeight    =   4020
  6. ClientLeft      =   1095
  7. ClientTop       =   1485
  8. ClientWidth     =   7365
  9. ControlBox      =   0   'False
  10. Height          =   4425
  11. Left            =   1035
  12. LinkTopic       =   "Form2"
  13. MaxButton       =   0   'False
  14. MinButton       =   0   'False
  15. MousePointer    =   11  'Hourglass
  16. ScaleHeight     =   4020
  17. ScaleWidth      =   7365
  18. Top             =   1140
  19. Width           =   7485
  20. WindowState     =   2  'Maximized
  21. Begin PictureBox Picture1
  22. AutoRedraw      =   -1  'True
  23. BorderStyle     =   0  'None
  24. Height          =   4035
  25. Left            =   0
  26. ScaleHeight     =   4035
  27. ScaleWidth      =   7395
  28. TabIndex        =   0
  29. Top             =   0
  30. Visible         =   0   'False
  31. Width           =   7395
  32. Dim ljunk As Integer
  33. Sub Form_Activate ()
  34.     mousepointer = HOURGLASS
  35.     ljunk = ShowWindow(RBProbRpt.hWnd, SW_HIDE)
  36.     ljunk = ShowWindow(RBErrFrm.hWnd, SW_HIDE)
  37.     ljunk = ShowWindow(RBScrn.hWnd, SW_HIDE)
  38.     DoEvents
  39.     mousepointer = HOURGLASS
  40.     GrabScreen
  41.     mousepointer = HOURGLASS
  42.     ljunk = ShowWindow(RBScrn.hWnd, SW_SHOW)
  43.     RBScrn.WindowState = MAXIMIZED
  44.     DoEvents
  45.     RBScrn.PrintForm
  46.     ljunk = ShowWindow(RBProbRpt.hWnd, SW_SHOW)
  47.     ljunk = ShowWindow(RBErrFrm.hWnd, SW_SHOW)
  48.     Unload RBScrn
  49. End Sub
  50. Sub GetTwipsPerPixel ()
  51.     ' Set a global variable with the Twips to Pixel ratio.
  52.     RBScrn.ScaleMode = 3
  53.     NumPix = RBScrn.ScaleHeight
  54.     RBScrn.ScaleMode = 1
  55.     TwipsPerPixel = RBScrn.ScaleHeight / NumPix
  56. End Sub
  57. Sub GrabScreen ()
  58.     Dim winSize As lrect
  59.     ' Assign information of the source bitmap.
  60.     ' Note that BitBlt requires coordinates in pixels.
  61.     hwndSrc% = GetDesktopWindow()
  62.     hSrcDC% = GetDC(hwndSrc%)
  63.     XSrc% = 0: YSrc% = 0
  64.     Call GetWindowRect(hwndSrc%, winSize)
  65.     nWidth% = winSize.right             ' Units in pixels.
  66.     nHeight% = winSize.bottom           ' Units in pixels.
  67.     ' Assign informate of the destination bitmap.
  68.     hDestDC% = RBScrn.Picture1.hDC
  69.     x% = 0: Y% = 0
  70.     ' Set global variable TwipsPerPixel and use to set
  71.     ' picture box to same size as screen being grabbed.
  72.     ' If picture box not the same size as picture being
  73.     ' BitBlt'ed to it, it will chop off all that does not
  74.     ' fit in the picture box.
  75.     GetTwipsPerPixel
  76.     RBScrn.Picture1.Top = 0
  77.     RBScrn.Picture1.Left = 0
  78.     RBScrn.Picture1.Width = (nWidth% + 1) * TwipsPerPixel
  79.     RBScrn.Picture1.Height = (nHeight% + 1) * TwipsPerPixel
  80.     ' Assign the value of the constant SRCOPYY to the Raster operation.
  81.     dwRop& = &HCC0020
  82.     ' Note function call must be on one line:
  83.     Suc% = BitBlt(hDestDC%, x%, Y%, nWidth%, nHeight%, hSrcDC%, XSrc%, YSrc%, dwRop&)
  84.     ' Release the DeskTopWindow's hDC to Windows.
  85.     ' Windows may hang if this is not done.
  86.     Dmy% = ReleaseDC(hwndSrc%, hSrcDC%)
  87.     'Make the picture box visible.
  88.     RBScrn.Picture1.Visible = True
  89. End Sub
  90.